InRainbows colour palettes …ya da ya da
library(tidyverse)
library(jpeg)
library(reshape2)
Define function to transform an image into tidy coordinate pairs with RGB values.
imTransform <- function(img){
i <- readJPEG(img)
dim_x <- dim(i)[1]
dim_y <- dim(i)[2]
df <-
melt(i) %>%
spread(Var3, value) %>%
rename(red="1", green="2", blue="3") %>%
mutate(Var1 = -Var1 + dim_y) %>%
rename(x=Var2, y=Var1) %>%
mutate(hex = pmap_chr(list(red, green, blue), rgb))
df
}
im_df <- imTransform("album_covers/the_bends.jpg")
head(im_df)
| y | x | red | green | blue | hex |
|---|---|---|---|---|---|
| 599 | 1 | 0.0745098 | 0.2000000 | 0.1058824 | #13331B |
| 599 | 2 | 0.0784314 | 0.2078431 | 0.1019608 | #14351A |
| 599 | 3 | 0.0823529 | 0.2117647 | 0.1058824 | #15361B |
| 599 | 4 | 0.0901961 | 0.2196078 | 0.0980392 | #173819 |
| 599 | 5 | 0.0980392 | 0.2313725 | 0.1019608 | #193B1A |
| 599 | 6 | 0.1058824 | 0.2392157 | 0.1019608 | #1B3D1A |
ncols <- 5 # Number of palette colors
kMeans <- kmeans(im_df[c("red", "green", "blue")], ncols)
Assign mean colours to all coordinate pairs
approxCol <- kMeans$centers[kMeans$cluster, ]
par(mfrow=c(1,3))
plot(im_df$x, im_df$y, col=rgb(im_df[,3:5]),
asp = 1, pch=".", axes=F, xlab="", ylab="", main="Original")
plot(im_df$x, im_df$y, col=rgb(approxCol),
asp = 1, pch=".", axes=F, xlab="", ylab="", main="Approximate")
palette <- table(rgb(approxCol)) %>% sort(decreasing = T)
barplot(palette, col=names(palette), axes=F, border=NA, main="Palette", las=2)
imPalette <- function(img, ncol=5, my.seed=3, ...){
i <- readJPEG(img)
mname <- str_extract(img, "(?<=/)[^.]+")
dim_x <- dim(i)[1]
dim_y <- dim(i)[2]
df <-
melt(i) %>%
spread(Var3, value) %>%
rename(red="1", green="2", blue="3") %>%
mutate(Var1 = -Var1 + dim_y) %>%
rename(x=Var2, y=Var1) %>%
tbl_df()
df$hex <- df %>% select(red, green, blue) %>% pmap_chr(rgb)
# Run Kmeans
set.seed(my.seed)
kMeans <- kmeans(df[c("red", "green", "blue")], ncol, ...)
# Caluclate aproximate colours
approxCol <- kMeans$centers[kMeans$cluster, ]
# Plot
par(mfrow=c(1,3))
plot(df$x, df$y, col=rgb(df[,3:5]),
asp = 1, pch=".", axes=F, xlab="", ylab="", main="Original")
plot(df$x, df$y, col=rgb(approxCol),
asp = 1, pch=".", axes=F, xlab="", ylab="", main="Approximate")
palette <- table(rgb(approxCol)) %>% sort(decreasing = T)
barplot(palette, col=names(palette), axes=F, border=NA, main="Palette", las=2)
return(assign(x=mname, value = palette, envir = .GlobalEnv))
}
paste0("album_covers/",list.files("album_covers")) %>%
sapply(imPalette, ncol=10) %>%
invisible()
## Warning: Quick-TRANSfer stage steps exceeded maximum (= 18000000)
## Warning: Quick-TRANSfer stage steps exceeded maximum (= 12103200)
pPal <- function(hex) barplot(rep(1, length(hex)), col=hex, border=NA, axes=F)
pablo_honey[c(1,2,5,6,9,10)] %>% names() %>% pPal()
the_bends[c(1,2,5,6)] %>% names() %>% pPal()
ok_computer[c(1,3,7,9,10)] %>% names() %>% pPal()
kid_a[c(1,2,6,8,10)] %>% names() %>% pPal()
amnesiac[c(1,2,10)] %>% names() %>% pPal()
httf[c(1,2,5,6,8,9,10)] %>% names() %>% pPal()
in_rainbows[c(1,2,5,6,7,9,10)] %>% names() %>% pPal()
king_of_limbs[c(1,2,4,5,7,8,10)] %>% names() %>% pPal()